home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1997 May / PC Plus Super CD Issue 127 (May 1997).iso / delphi1 / lesson3 / calc3 / calc3.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-27  |  8.4 KB  |  339 lines
  1. unit Calc3;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls;
  8.  
  9. type
  10.   TCalcForm = class(TForm)
  11.     DisplayEd: TEdit;
  12.     Btn8: TButton;
  13.     Btn6: TButton;
  14.     Btn4: TButton;
  15.     Btn2: TButton;
  16.     Btn0: TButton;
  17.     Btn9: TButton;
  18.     Btn7: TButton;
  19.     Btn5: TButton;
  20.     Btn3: TButton;
  21.     Btn1: TButton;
  22.     BtnEquals: TButton;
  23.     BtnDiv: TButton;
  24.     BtnMult: TButton;
  25.     BtnMinus: TButton;
  26.     BtnPlus: TButton;
  27.     BtnDot: TButton;
  28.     ClearBtn: TButton;
  29.     procedure Btn0Click(Sender: TObject);
  30.     procedure Btn1Click(Sender: TObject);
  31.     procedure Btn2Click(Sender: TObject);
  32.     procedure Btn3Click(Sender: TObject);
  33.     procedure Btn4Click(Sender: TObject);
  34.     procedure Btn5Click(Sender: TObject);
  35.     procedure Btn6Click(Sender: TObject);
  36.     procedure Btn7Click(Sender: TObject);
  37.     procedure Btn8Click(Sender: TObject);
  38.     procedure Btn9Click(Sender: TObject);
  39.     procedure ClearBtnClick(Sender: TObject);
  40.     procedure FormActivate(Sender: TObject);
  41.     procedure BtnPlusClick(Sender: TObject);
  42.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  43.     procedure BtnEqualsClick(Sender: TObject);
  44.     procedure BtnDivClick(Sender: TObject);
  45.     procedure BtnMultClick(Sender: TObject);
  46.     procedure BtnMinusClick(Sender: TObject);
  47.     procedure BtnDotClick(Sender: TObject);
  48.   private
  49.     { Private declarations }
  50.     EnterNewFigures: boolean;{ flag if new number is being entered }
  51.     { The following Methods aren't event-handlers and are
  52.     not bound to specific visual objects }
  53.     procedure UpdateResult( newOp : char );
  54.     procedure AppendNumber( numCh : char );
  55.     procedure ReInit;
  56.  
  57.   public
  58.     { Public declarations }
  59.  
  60.   end;
  61.  
  62. { TMemory is a non-visual class which simply stores the previous value
  63. which appeared in the calculator's edit box. Say, for example, we had
  64. a TMemory object called PrevVal, we can now pick and operator, such
  65. as '+' and then enter a new value, called NewVal. When we press the
  66. '=' button (or another operator button such as '+' or '-'), the edit
  67. box can be updated to show the total of PrevVal + NewVal ).    }
  68. TMemory = class(TObject)
  69.   total : real;
  70.   function gettotal : real;
  71.   procedure settotal( r : real );
  72. end;
  73.  
  74. TMemory2 = class(TMemory)
  75.   procedure beep;
  76. end;
  77.  
  78. { Stores the currently selected operator such as '+' or '-' }
  79. TOperation = class(TObject)
  80.   op : char;
  81.   function getop : char;
  82.   procedure setop( c : char );
  83. end;
  84.  
  85.  
  86. var
  87.   CalcForm: TCalcForm;
  88.   LastResult : TMemory;
  89.   LastOp : TOperation;
  90.  
  91. implementation
  92.  
  93. {$R *.DFM}
  94. procedure TMemory2.beep;
  95. begin
  96. end;
  97.  
  98. { Methods of the TMemory class. Set and read the internal variable }
  99. function TMemory.gettotal : real;
  100. begin
  101.  gettotal := total;
  102. end;
  103.  
  104. procedure TMemory.settotal( r : real );
  105. begin
  106.  total := r;
  107. end;
  108.  
  109.  
  110.  
  111. { Methods of the TOperation class }
  112. function TOperation.getop : char;
  113. begin
  114.  getop := op;
  115. end;
  116.  
  117. procedure TOperation.setop( c : char );
  118. begin
  119.  op := c;
  120. end;
  121.  
  122. { ------------- general-purpose routines ---------------- }
  123.  
  124. { warn user if an erroneous value has been entered - e.g. '1..5' and
  125. allows them to edit the value before continuing }
  126. procedure InputError( TE: TEdit; errcode : integer );
  127. var
  128.    Msg : string;
  129. begin
  130.     if TE.Text = '' Then
  131.        Msg := 'You must enter a value'
  132.     else
  133.        Msg :=  'Invalid character: ' + Copy(TE.Text, errcode, 1);
  134.     MessageDlg(Msg, mtError,
  135.             [mbOk], 0);
  136.     TE.SetFocus;
  137.     TE.SelStart := errcode-1;
  138.     TE.SelLength := 1;
  139. end;
  140.  
  141. { checks to see if the value in the edit box is valid. if so,
  142. the value is returned in the variable, realValue and the function
  143. returns True. Otherwise, it returns false }
  144. function CurrentNumberOK( TE: TEdit; var realValue : real ) : boolean;
  145. var
  146.  rv : real;
  147.  errcode : integer;
  148. begin
  149.    Val(TE.Text, rv, errcode);
  150.    if errcode = 0 then
  151.    begin
  152.       realValue := rv;
  153.       CurrentNumberOK := true;
  154.    end
  155.    else
  156.    begin
  157.       InputError(TE, errcode );
  158.       CurrentNumberOK := false;
  159.    end;
  160. end;
  161.  
  162. procedure TCalcForm.ReInit;
  163. { Clear memory, clear edit field }
  164. begin
  165.   DisplayEd.Text := '';
  166.   LastResult.settotal(0.0);
  167.   LastOp.setOp('+');
  168.   EnterNewFigures := true;
  169. end;
  170.  
  171. procedure TCalcForm.UpdateResult( newOp : char );
  172. { When an operator (newOp) is chosen, this method performs the current
  173. calculation and updates the Op field of the LastOp object so that
  174. this is avalable for use in the current calculation }
  175. var
  176.    lastNum : real;
  177.    lastOperator : char;
  178.    newNum : real;
  179.    total : real;
  180.    strTotal : string;
  181. begin
  182.   newNum := 0.0;
  183.  
  184. { The code in this method only executes if the contents of the
  185.   edit field are valid. If an error is encountered, nothing is done.
  186.   This gives the user the chance to correct the error before
  187.   continuing }
  188.   if CurrentNumberOK( DisplayEd, newNum ) then
  189.   begin
  190.       { retrieve the previous value and operator needed for this
  191.       calculation }
  192.     lastNum := LastResult.gettotal;
  193.     lastOperator := LastOp.getop;
  194.     { use a CASE statment to select the appropriate calculation }
  195.     case lastOperator of
  196.       '+': total := lastNum + newNum;
  197.       '-': total := lastNum - newNum;
  198.       '/': total := lastNum / newNum;
  199.       '*': total := lastNum * newNum;
  200.       else total := lastNum; { i.e. if '=' was selected}
  201.     end;
  202.     { Convert the real value, total, to the string value,
  203.       strTotal and display it in the edit box }
  204.     Str(total:2:2, strTotal );
  205.     DisplayEd.Text := strTotal;
  206.     { update the lastOp and lastResult objects,
  207.       ready for the next calculation }
  208.     lastOp.setOp( newOp );
  209.     lastResult.settotal(total);
  210.     { set the EnterNewFigures variable to true. This is used in the
  211.     AppendNumber method }
  212.     EnterNewFigures := true;
  213.   end;
  214. end;
  215.  
  216. procedure TCalcForm.AppendNumber( numCh : char );
  217. { If a calculation has just been completed, the EnterNewFigures
  218.   variable is True. So the edit box is cleared to let the user
  219.   start entering a new number. Otherwise, digits are appended
  220.   to the contents of the edit box }
  221. begin
  222.    if EnterNewFigures = true then
  223.    begin
  224.       DisplayEd.Text := '';
  225.       EnterNewFigures := false;
  226.    end;
  227.       DisplayEd.Text := DisplayEd.Text + numCh;
  228. end;
  229.  
  230. { the form's event-handling code }
  231. { Each button sends a number to be added to the edit box }
  232. procedure TCalcForm.Btn0Click(Sender: TObject);
  233. begin
  234.      AppendNumber( '0' );
  235. end;
  236.  
  237. procedure TCalcForm.Btn1Click(Sender: TObject);
  238. begin
  239.      AppendNumber( '1' );
  240. end;
  241.  
  242. procedure TCalcForm.Btn2Click(Sender: TObject);
  243. begin
  244.      AppendNumber( '2' );
  245. end;
  246.  
  247. procedure TCalcForm.Btn3Click(Sender: TObject);
  248. begin
  249.      AppendNumber( '3' );
  250. end;
  251.  
  252. procedure TCalcForm.Btn4Click(Sender: TObject);
  253. begin
  254.      AppendNumber( '4' );
  255. end;
  256.  
  257. procedure TCalcForm.Btn5Click(Sender: TObject);
  258. begin
  259.      AppendNumber( '5' );
  260. end;
  261.  
  262. procedure TCalcForm.Btn6Click(Sender: TObject);
  263. begin
  264.      AppendNumber( '6' );
  265. end;
  266.  
  267. procedure TCalcForm.Btn7Click(Sender: TObject);
  268. begin
  269.      AppendNumber( '7' );
  270. end;
  271.  
  272. procedure TCalcForm.Btn8Click(Sender: TObject);
  273. begin
  274.      AppendNumber( '8' );
  275. end;
  276.  
  277. procedure TCalcForm.Btn9Click(Sender: TObject);
  278. begin
  279.      AppendNumber( '9' );
  280. end;
  281.  
  282. procedure TCalcForm.ClearBtnClick(Sender: TObject);
  283. begin
  284.   ReInit;
  285. end;
  286.  
  287. procedure TCalcForm.FormActivate(Sender: TObject);
  288. { When the calculator is first run, we create the two
  289. objects, LastResult and LastOp and call ReInit to do some
  290. setup tasks }
  291. begin
  292.   LastResult := TMemory.Create;
  293.   LastOp := TOperation.Create;
  294.   ReInit;
  295. end;
  296.  
  297.  
  298. procedure TCalcForm.FormClose(Sender: TObject; var Action: TCloseAction);
  299. { When the calculator is closed, we 'clean up' by destroying the objects
  300. we created in the FormActivate method }
  301. begin
  302.  LastResult.Free;
  303.  LastOp.Free;
  304. end;
  305.  
  306. { The operator buttons }
  307.  
  308. procedure TCalcForm.BtnEqualsClick(Sender: TObject);
  309. begin
  310.      UpdateResult( '=' );
  311. end;
  312.  
  313. procedure TCalcForm.BtnDivClick(Sender: TObject);
  314. begin
  315.      UpdateResult( '/' );
  316. end;
  317.  
  318. procedure TCalcForm.BtnMultClick(Sender: TObject);
  319. begin
  320.      UpdateResult( '*' );
  321. end;
  322.  
  323. procedure TCalcForm.BtnPlusClick(Sender: TObject);
  324. begin
  325.      UpdateResult( '+' );
  326. end;
  327.  
  328. procedure TCalcForm.BtnMinusClick(Sender: TObject);
  329. begin
  330.      UpdateResult( '-' );
  331. end;
  332.  
  333. procedure TCalcForm.BtnDotClick(Sender: TObject);
  334. begin
  335.      AppendNumber( '.' );
  336. end;
  337.  
  338. end.
  339.